;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          audioscrobbler.lisp
;;;; Purpose:       Audioscrobbler/lastfm wrapper
;;;; Programmer:    Nicolas Lamirault <nicolas.lamirault@gmail.com>
;;;;
;;;; This file, part of audioscrobbler, is Copyright (c) 2007 by Nicolas Lamirault
;;;;
;;;; cl-audioscrobbler users are granted the rights to distribute and use this software
;;;; as governed by the terms of the MIT License :
;;;; http://www.opensource.org/licenses/mit-license.php
;;;;
;;;; *************************************************************************


(in-package :cl-audioscrobbler)


(defun md5sum-to-hexa (md5-hash)
  "Convert MD5-HACH to a string representation in Hexadecimal format."
  (let (hexa)
    (with-output-to-string (os)
      (loop for i across md5-hash
         do (format os "~2,'0x" i))
      (setf hexa (get-output-stream-string os)))
    (string-downcase hexa)))


(defun get-md5sum-code (password token)
  "Create a string like md5(md5(PASSWORD) + TOKEN)."
  (let ((seq (concatenate 'string
                          (md5sum-to-hexa (md5:md5sum-sequence password))
                          token)))
    (md5sum-to-hexa (md5:md5sum-sequence seq))))


(defun url-encode-utf8 (url)
  "URL encode in UTF-8 the URL."
  (url-rewrite:url-encode
    (trivial-utf-8:utf-8-bytes-to-string
     (trivial-utf-8:string-to-utf-8-bytes url))))


(defclass last-fm-client ()
  ((id :initform nil
       :initarg :id
       :accessor last-fm-client-id
       :documentation "Identifiant of the Last.FM client.")
   (version :initform nil
            :initarg :version
            :accessor last-fm-client-version
            :documentation "Version of the Last.FM client.")
   (username :initform nil
             :initarg :username
             :accessor last-fm-client-username
             :documentation "Login of the Last.FM account.")
   (password :initform nil
             :initarg :password
             :accessor last-fm-client-password
             :documentation "Password of the Last.FM account."))
  (:documentation "A Last.FM client."))


(defun make-client (username password id version)
  "Creates a new Last.FM client."
  (make-instance 'last-fm-client
                 :username username
                 :password password
                 :id id
                 :version version))


(defgeneric post-song (last-fm-client protocol artist album song length time)
  (:documentation "Make an HTTP request to post current song informations :
ARTIST, ALBUM, SONG and LENGTH.
PROTOCOL specify which version of the Audioscrobbler protocol use.
Throws a AUDIOSCROBBLER-PROTOCOL-ERROR if an error is sent by
the Audioscrobbler server.
Throws a SIMPLE-ERROR if an error occurs during the http request."))


(defmethod post-song ((last-fm-client last-fm-client) (protocol (eql :1.1))
                      artist album song length time)
  (with-slots (id version username password) last-fm-client
    (post-song-1.1 username password artist album song length id version)))


(defmethod post-song ((last-fm-client last-fm-client) (protocol (eql :1.2))
                      artist album song length time)
  (warn "Protocol ~A not supported" protocol))


;;
;; Protocol 1.1
;;

(defun handshake-1.1 (username &key (client-id +client-id+) 
                      (client-version +client-version+))
"Make an HTTP request to retreive challenge for protocol identification.
Returns 2 values : MD5 challenge and URL.
Throws a AUDIOSCROBBLER-PROTOCOL-ERROR if an error is sent by
the Audioscrobbler server.
Throws a SIMPLE-ERROR if an error occurs during the http request."
 (let ((query (format nil +protocol-identify-1.1+
                      client-id client-version username)))
   (when *debug*
     (format t "Audioscrobbler 1.1 Ident :~&~A~%" query))
   (multiple-value-bind (body status-code headers uri stream must-close)
       (drakma:http-request query )
     (declare (ignore headers uri stream must-close))     
     (if (and status-code (= status-code 200))
         (with-input-from-string (stream body)
           (loop as line = (read-line stream nil)
              until (null line)
              do
                (when *debug*
                  (format t "Audioscrobbler response : [~A]~%" line))
                (cond ((cl-ppcre:scan "UPTODATE" line)
                       (let ((challenge (read-line stream nil))
                             (url (read-line stream nil)))
                         (return (values challenge url))))
                      ((cl-ppcre:scan "BADUSER" line)
                       (error 'audioscrobbler-protocol-error
                              :message "Invalid user"))
                      ((cl-ppcre:scan "FAILED" line)
                       (error 'audioscrobbler-protocol-error
                              :message line))
                      (t ))))
         (error (format nil "Audioscrobbler Handshake error : ~A : ~&~A"
                        status-code body))))))


(defun post-song-1.1 (username password artist album song length
                      client-id client-version)
"Make an HTTP request to post current song informations (ARTIST, ALBUM, SONG
and LENGTH).
CLIENT-ID and CLIENT-VERSION are the Last.fm/Audioscrobbler software
identification.
USERNAME and PASSWORD are the Last.fm/Audioscrobbler user's account informations.
Throws a AUDIOSCROBBLER-PROTOCOL-ERROR if an error is sent by
the Audioscrobbler server.
Throws a SIMPLE-ERROR if an error occurs during the http request."
  (multiple-value-bind (challenge url)
      (handshake-1.1 username :client-id client-id :client-version client-version)
    (when *debug*
      (format t "~&Challenge: ~A~&Url: ~A~%" challenge url))
    (let* ((md5 (get-md5sum-code password challenge))
           (query
            (concatenate 'string url "?"
                         (format nil +protocol-post-1.1+
                                 (url-encode-utf8 username)
                                 (url-encode-utf8 md5)
                                 (url-encode-utf8 artist)
                                 (url-encode-utf8 song)
                                 (url-encode-utf8 album)
                                 ""
                                 (url-encode-utf8 length)
                                 (url-encode-utf8 (get-current-date))))))
      (when *debug*
        (format t "~&Audioscrobbler Post :~&~A~%" query))
     (multiple-value-bind (body status-code headers uri stream must-close)
         (drakma:http-request query :method :post)
     (declare (ignore headers uri stream must-close))
     (if (and status-code (= status-code 200))
         (if body
             (with-input-from-string (stream body)
               (loop as line = (read-line stream nil)
                  until (null line)
                  do
                    (when *debug*
                      (format t "~&Audioscrobbler POST response : ~A" line))
                    (cond ((cl-ppcre:scan "OK" line)
                           (return t))
                          ((cl-ppcre:scan "BADAUTH" line)
                           (error 'audioscrobbler-protocol-error
                                  :message "Handshake problem"))
                          ((cl-ppcre:scan "FAILED" line)
                           (error 'audioscrobbler-protocol-error
                                  :message line))
                          (t (warn "Audioscrobbler respone : ~A" body)))))
             (warn "Audioscrobbler : empty answer."))
         (error (format nil "Audioscrobbler POST error : ~A : ~&~A"
                        status-code body)))))))


;;
;; Protocol 1.2
;;


;; (defun handshake-1.2 (username password &key (client-id +client-id+) 
;;                       (client-version +client-version+))
;;  "Make an HTTP request to retreive challenge for protocol identification.
;; Returns 2 values : ID and URL.
;; Throws a AUDIOSCROBBLER-PROTOCOL-ERROR if an error is sent by
;; the Audioscrobbler server.
;; Throws a SIMPLE-ERROR if an error occurs during the http request."
;;  (let* ((time (format nil "~A" (unix-timestamp)))
;;         (auth (get-md5sum-code password time))
;;         (query (format nil +protocol-identify-1.2+
;;                        client-id client-version username time auth)))
;;    (when *debug*
;;      (format t "Audioscrobbler 1.2 Ident :~&~A~%" query))
;;    (multiple-value-bind (body status-code headers uri stream must-close)
;;        (drakma:http-request query)
;;      (declare (ignore headers uri stream must-close))     
;;      (if (and status-code (= status-code 200))
;;          (with-input-from-string (stream body)
;;            (loop as line = (read-line stream nil)
;;               until (null line)
;;               do
;;                 (cond ((cl-ppcre:scan "OK" line)
;;                        (let ((challenge (read-line stream nil))
;;                              (url (read-line stream nil)))
;;                          (values challenge url)))
;;                       ((cl-ppcre:scan "BANNED" line)
;;                        (error 'audioscrobbler-protocol-error
;;                               :message "This client version has been banned from the server."))
;;                       ((cl-ppcre:scan "BADAUTH" line)
;;                        (error 'audioscrobbler-protocol-error
;;                               :message "The authentication details provided were incorrect"))
;;                       ((cl-ppcre:scan "BADTIME" line)
;;                        (error 'audioscrobbler-protocol-error
;;                               :message "The timestamp provided was not close enough to the current time"))
;;                       ((cl-ppcre:scan "FAILED" line)
;;                        (error 'audioscrobbler-protocol-error
;;                               :message line))
;;                       ((cl-ppcre:scan "OK" line)
;;                        body)
;;                       (t (error (format nil "Audioscrobbler protocol error : ~A"
;;                                         line))))))
;;          (error (format nil "Audioscrobbler error : ~A : ~&~A"
;;                         status-code body))))))


;; (defun post-song-1.2 (username password artist album song length time)
;;  (multiple-value-bind (challenge url)
;;      (handshake-1.2 username password)
;;    (let* ((md5 (get-md5sum-code password challenge))
;;           (query (format nil (concatenate 'string url "?" +protocol-post-1.2+)
;;                          artist song album
;;                          length time (get-current-date) username))
;;           (uri (cl-ppcre:regex-replace-all " "
;;                                            (url-rewrite:add-get-param-to-url query "s" md5)
;;                                            "+")))
;;      (print uri)
;;      (multiple-value-bind (body status-code headers uri stream must-close)
;;          (drakma:http-request (url-rewrite:url-encode query))
;;      (declare (ignore headers uri stream must-close))
;;      (when (and status-code (= status-code 200))
;;          (with-input-from-string (stream body)
;;            (loop as line = (read-line stream nil)
;;               until (null line)
;;               do (print line))))))))



